home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 10 / FM Towns Free Software Collection 10.iso / ms_dos / lib / happysrc / pcexpres.c < prev    next >
Text File  |  1994-11-14  |  37KB  |  916 lines
  1. /************************************************************/
  2. /*                                                          */
  3. /*       *** HAPPy Pascal Compiler ***                      */
  4. /*        式のコンパイル処理                                */
  5. /*      void expression(Set fsys) ;                         */
  6. /*                                                          */
  7. /*                 Copyright (c) H.Asano 1992,1994.         */
  8. /*                                                          */
  9. /************************************************************/
  10.  
  11. #define EXTERN extern
  12. #include "pascomp.h"
  13. #include "pcpcd.h"
  14.  
  15. extern void gen0(enum pcdmnc) ;
  16. extern void genp(enum pcdmnc,int) ;
  17. extern void gen0t(enum pcdmnc,stp*) ;
  18. extern void gen1t(enum pcdmnc,stp*,int)     ;
  19. extern void gen2t(enum pcdmnc,stp*,int,int) ;
  20. extern void gencompare(enum pcdmnc,char,int) ;
  21. extern void genldc(char,long) ;
  22. extern void genixa(long,int)  ;
  23. extern void genchk(stp*,int,long,long) ;
  24. extern void convertint(stp*)  ;
  25. extern void load(void) ;
  26. extern void loadaddress(void) ;
  27. extern ctp  *searchsection(ctp*) ;
  28. extern ctp  *searchid(Set) ;
  29. extern void insymbol(void) ;
  30. extern void pcerr(int,char*);
  31. extern char *inttoch(long)  ;
  32. extern void skip(Set) ;
  33. extern boolean string(stp*) ;
  34. extern boolean compatible(stp*,stp*) ;
  35. extern void getbounds(stp*,long*,long*) ;
  36. extern int align(stp*,int) ;
  37. extern void conststrings(stp**, union valu*) ;
  38. extern Set  *mkset(Set*,int,...) ;
  39. extern Set  *orset(Set*,Set*) ;
  40. extern void call(Set,ctp*) ;
  41. extern void *Malloc(int)   ;
  42. static void array(Set) ;
  43. static void recordmember(void) ;
  44. static void ptr(void) ;
  45. static void factident(Set) ;
  46. static void factconst(Set) ;
  47. static void factlparent(Set) ;
  48. static void factnot(Set)   ;
  49. static void factset(Set)   ;
  50. static void factset2(Set,stp*,long*,boolean*,boolean*) ;
  51. static void factnil(void)  ;
  52. static void simpleexpression(Set) ;
  53. static void plusminusope(attr,enum operator) ;
  54. static void orope(attr)    ;
  55. static void mulope(attr)   ;
  56. static void rdivope(attr)  ;
  57. static void inope(attr)    ;
  58. static void relope(attr,enum operator)  ;
  59. static void cnvfloat(attr*)   ;
  60.  
  61. /*******************************************/
  62. /* expression() : 式のコンパイル処理メイン */
  63. /*******************************************/
  64. void expression(Set fsys)
  65. {
  66.   attr lattr ;
  67.   enum operator lop ;
  68.   Set ws ;
  69.  
  70.      ws = fsys ;
  71.      addset(ws,relop) ;
  72.      simpleexpression(ws) ;
  73.  
  74.      if(sy == relop) {                  /* 関係演算子の時             */
  75.       if(gattr.typtr)
  76.        if(gattr.typtr->form <= power)   /*  スカラ､範囲型､集合型の時  */
  77.         load() ;                        /*   load命令                 */
  78.        else loadaddress() ;             /*  それ以外は間接参照        */
  79.       lattr = gattr ;                   /* 今の式の属性を退避         */
  80.       lop   = op    ;                   /* 今の演算子を退避           */
  81.  
  82.       if(lop == inop)                   /* in の時 integerでなければ  */
  83.        if(gattr.typtr && (gattr.typtr->form == scalar) &&
  84.           (gattr.typtr != realptr))    /* inの前の式が順序型の時     */
  85.         convertint(gattr.typtr) ;       /* 必要ならord命令生成        */
  86.  
  87.       insymbol()    ;
  88.       simpleexpression(fsys) ;          /* 関係演算子の次の単純式の処理*/
  89.       if(gattr.typtr)
  90.        if(gattr.typtr->form <= power)   /* スカラ､範囲型､集合型の時   */
  91.         load() ;                        /*  load命令                  */
  92.        else loadaddress() ;             /* それ以外は間接参照         */
  93.  
  94.       if((lattr.typtr) && (gattr.typtr))
  95.        if(lop == inop) inope(lattr) ;   /* in 演算子処理              */
  96.        else {
  97.         if(lattr.typtr != gattr.typtr)
  98.          cnvfloat(&lattr) ;             /* realへの変換処理           */
  99.  
  100.         if(compatible(lattr.typtr,gattr.typtr))  /* 両方の型が同じ    */
  101.          relope(lattr,lop) ;            /* 関係演算子の処理           */
  102.         else pcerr(143,"") ;            /* 演算子の両端の型が不一致   */
  103.        }
  104.  
  105.       gattr.typtr = boolptr ;
  106.       gattr.kind  = expr    ;           /* これ以降論理型の式とする   */
  107.      }
  108.  
  109. }
  110.  
  111. /**************************************/
  112. /*      inope() : in 演算子処理       */
  113. /**************************************/
  114. static void inope(attr fattr)
  115. {
  116.      if(gattr.typtr->form == power)           /* 今の型が集合型          */
  117.       if(compatible(fattr.typtr,gattr.typtr->sf.pw.elset))
  118.                                               /* 底基の型と等しいか      */
  119.        gen0(iINN) ;                           /* inn命令を生成           */
  120.       else {
  121.        pcerr(143,"") ;                        /* 演算子の両端の型が不一致*/
  122.        gattr.typtr = nil ;
  123.       }
  124.      else {
  125.       pcerr(130,"") ;                         /* 式は集合型でない        */
  126.       gattr.typtr = nil  ;
  127.      }
  128. }
  129.  
  130. /*****************************************/
  131. /*  relope() : in 以外の関係演算子処理   */
  132. /*              =  <  >  <>  <=  >=      */
  133. /*****************************************/
  134. static void relope(attr fattr,enum operator fop)
  135. {
  136.   int lsize ;                           /* 比較する大きさ             */
  137.   char typind ;                         /* 比較命令の型               */
  138.   enum pcdmnc pcd ;                     /* 生成P-code                 */
  139.  
  140.      lsize = fattr.typtr->size ;        /* その型の大きさ             */
  141.  
  142.      switch(fattr.typtr->form) {        /* 型で振り分ける             */
  143.       case scalar :                     /* スカラー                   */
  144.         if(fattr.typtr == realptr)      typind = 'r' ;  /* real       */
  145.         else if(fattr.typtr == boolptr) typind = 'b' ;  /* boolean    */
  146.         else if(fattr.typtr == charptr) typind = 'c' ;  /* char       */
  147.         else                            typind = 'i' ;  /* integer/列挙型*/
  148.         break ;
  149.       case pointer :                    /* ポインタ型                 */
  150.         if((fop != eqop) && (fop != neop)) /* =  <> 以外              */
  151.          pcerr(131,"") ;                /* 等しいかどうかの判定しか駄目*/
  152.         typind = 'a'   ;
  153.         break ;
  154.       case power   :                    /* 集合型                     */
  155.         if((fop == ltop) || (fop == gtop)) /* <  >  の時              */
  156.          pcerr(132,"") ;                /*  完全包含の判定は駄目      */
  157.         typind = 's'   ;
  158.         break ;
  159.       case arrays :                     /* 配列型                     */
  160.         if(! string(fattr.typtr))       /*  文字列でない時            */
  161.          pcerr(134,"") ;                /*  演算対象の型に誤り        */
  162.          typind = 'm'  ;
  163.          break ;
  164.       case records :                    /* レコード型                 */
  165.         pcerr(134,"")  ;                /*  レコード型は駄目          */
  166.         typind = 'm'   ;
  167.         break          ;
  168.       case files :                      /* ファイル型                 */
  169.         pcerr(133,"")  ;                /*   ファイルの比較は駄目     */
  170.         typind = 'f'   ;
  171.      }
  172.  
  173.      switch(fop) {                      /* 演算子で生成命令を区別     */
  174.       case ltop : pcd = iLES ; break ;  /* <  les命令                 */
  175.       case leop : pcd = iLEQ ; break ;  /* <= leq命令                 */
  176.       case gtop : pcd = iGRT ; break ;  /* >  grt命令                 */
  177.       case geop : pcd = iGEQ ; break ;  /* >= geq命令                 */
  178.       case neop : pcd = iNEQ ; break ;  /* <> neq命令                 */
  179.       case eqop : pcd = iEQU ;          /* =  neq命令                 */
  180.      }
  181.      gencompare(pcd,typind,lsize)    ;  /* 命令生成                   */
  182. }
  183.  
  184. /**************************************/
  185. /* cnvfloat() : realへの変換処理      */
  186. /**************************************/
  187. static void cnvfloat(attr *fattr)
  188. {
  189.  
  190.       if((*fattr).typtr == intptr) {    /* 前の式がinteger            */
  191.        gen0(iFLO) ;                     /*  前の式を realに変換       */
  192.        (*fattr).typtr = realptr ;
  193.       } ;
  194.       if(gattr.typtr == intptr) {       /* 今の式integer              */
  195.        gen0(iFLT) ;                     /*  今の式をrealに変換        */
  196.        gattr.typtr = realptr ;
  197.       }
  198. }
  199.  
  200. /***************************************/
  201. /* selector() : 変数の属性を選択する   */
  202. /*      α[･･･]  :  配列変数           */
  203. /*      α^      :  ポインタ変数       */
  204. /*      α.      : レコード変数        */
  205. /***************************************/
  206. void selector(Set fsys, ctp *fcp)
  207. {
  208.   Set ws ;
  209.  
  210.      gattr.typtr = fcp->idtype ;        /* 型を設定                   */
  211.      gattr.kind  = varbl       ;        /* 種類は 変数                */
  212.      switch(fcp->klass) {               /* 変数の型で振り分ける       */
  213.       case vars :                       /*[変数]                      */
  214.         if(fcp->n.v.vkind == actual) {  /*  実変数                    */
  215.          gattr.access = drct ;
  216.          gattr.vlevel = fcp->n.v.vlev ;
  217.          gattr.dplmt  = fcp->n.v.vaddr;
  218.         }
  219.         else {                          /*  formal (変数引数)         */
  220.          if(gattr.typtr->form != files) /* ﾌｧｲﾙ型はlodaを生成しない   */
  221.           gen2t(iLOD,nilptr,level-fcp->n.v.vlev,fcp->n.v.vaddr) ;
  222.          gattr.access = indrct ;
  223.          gattr.idplmt = 0      ;
  224.          gattr.vlevel = fcp->n.v.vlev ; /* ファイルが変数引数の時の   */
  225.          gattr.dplmt  = fcp->n.v.vaddr; /* ために退避しておく         */
  226.         }                               /* 本当はこのやり方は違反です */
  227.         break ;
  228.  
  229.       case field :                      /* レコードのフィールド       */
  230.                                         /* with文配下しかこないはず   */
  231.         if(display[disx].occur == crec){/* 固定フィールドの時         */
  232.          gattr.access = drct ;
  233.          gattr.vlevel = display[disx].clev ;
  234.          gattr.dplmt  = display[disx].cdspl+ fcp->n.fldaddr ;
  235.         }
  236.         else {                          /* vrec(可変フィールドの時)   */
  237.          if(level == 1)                 /* 大域変数                   */
  238.           gen1t(iLDO,nilptr,display[disx].vdspl) ;        /* ldo命令  */
  239.          else  gen2t(iLOD,nilptr,0,display[disx].vdspl) ; /* lod命令  */
  240.          gattr.access = indrct ;
  241.          gattr.idplmt = fcp->n.fldaddr ;
  242.         }
  243.        break;
  244.  
  245.       case func  :                      /* 関数                       */
  246.         gattr.access = drct ;
  247.         gattr.vlevel = fcp->n.pf.sd.d.pflev + 1 ;
  248.         gattr.dplmt  = 0    ;
  249.  
  250.      }
  251.  
  252.      ws = selectsys ;
  253.      orset(&ws,&fsys) ;
  254.      if(! inset(ws,sy)) {
  255.       pcerr(59,"") ;                    /* 変数に誤りがある           */
  256.       skip(ws)     ;                    /* fsys+selectsysまで読み飛ばし*/
  257.      }
  258.  
  259.      while(inset(selectsys,sy)) {       /* [  .  ^  の間処理する      */
  260.       if(sy == lbrack)                  /*  [ の時                    */
  261.        array(fsys) ;                    /*   配列の処理               */
  262.       else if(sy == period)             /*  . の時                    */
  263.        recordmember() ;                 /*   レコードの各要素の処理   */
  264.       else                              /*  ^ の時                    */
  265.        ptr() ;                          /*    ポインタの処理          */
  266.  
  267.       if(! inset(ws,sy)) {
  268.        pcerr(6,"") ;                    /* 不当な記号が現れた         */
  269.        skip(ws) ;
  270.       }
  271.      }
  272. }
  273.  
  274. /*****************************************/
  275. /* recordmember() : レコードの要素の処理 */
  276. /*****************************************/
  277. static void recordmember(void)
  278. {
  279.   ctp *lcp ;
  280.  
  281.      if(gattr.typtr)
  282.       if(gattr.typtr->form != records) {
  283.        pcerr(140,"") ;                  /* 変数の型がレコード型でない */
  284.        gattr.typtr = nil ;              /* 今後のエラー防止のためnilにする*/
  285.       }
  286.  
  287.      insymbol() ;                       /* 次のsymbol                 */
  288.      if(sy == ident) {                  /*  名前                      */
  289.       if(gattr.typtr) {                 /*  レコードの要素から名前を探す*/
  290.        lcp = searchsection(gattr.typtr->sf.re.fstfld) ;
  291.        if(!lcp) {                       /*  名前がない時              */
  292.         pcerr(152,id) ;                 /*  レコードの欄ではない      */
  293.         gattr.typtr = nil ;             /* 今後のエラー防止のためnilにする*/
  294.        }
  295.        else {                           /* 名前がレコードの欄の時     */
  296.         gattr.typtr = lcp->idtype ;     /*   名前の型                 */
  297.         if(gattr.access==drct)          /* 直接参照の時               */
  298.            gattr.dplmt += lcp->n.fldaddr ;
  299.         else                            /* 間接参照の時(indrct)       */
  300.            gattr.idplmt += lcp->n.fldaddr ;
  301.        }
  302.       }                                 /* end (typtr != nil)         */
  303.       insymbol() ;                      /* 名前の次を読み込む         */
  304.      }
  305.      else pcerr(2,"") ;                 /* 名前がない                 */
  306. }
  307.  
  308. /*****************************************/
  309. /*      array() : 配列の処理             */
  310. /*****************************************/
  311. static void array(Set fsys)
  312. {
  313.   attr lattr ;                          /* 1つ前の属性                */
  314.   long lmin,lmax ;
  315.   int lsize ;
  316.   int incsize ;
  317.   Set  ws    ;
  318.  
  319.      do {                               /* 多次元配列のための繰り返し */
  320.       lattr = gattr ;
  321.       if(lattr.typtr)
  322.        if(lattr.typtr->form != arrays) {
  323.         pcerr(138,"") ;                 /* 変数の型は配列でない       */
  324.         lattr.typtr = nil ;
  325.         gattr.typtr = nil ;             /* loadaddressをさせない      */
  326.        }
  327.       loadaddress() ;
  328.       insymbol() ;
  329.       mkset(&ws, comma,rbrack, -1) ;
  330.       orset(&ws, &fsys) ;
  331.       expression(ws)    ;               /* 添え字の式の処理           */
  332.  
  333.       if(gattr.typtr) {
  334.        if(gattr.typtr->form != scalar)
  335.         pcerr(113,"") ;                 /* 添え字の型はスカラか範囲型 */
  336.        lsize = lattr.typtr->sf.ar.aeltype->size ;
  337.        lsize = align(gattr.typtr,lsize) ; /* 境界合わせ               */
  338.       }
  339.       if(lattr.typtr) {
  340.        if(compatible(lattr.typtr->sf.ar.inxtype,
  341.                      gattr.typtr)) {    /* 添え字の型と等しい         */
  342.         if(lattr.typtr->sf.ar.inxtype) {
  343.          getbounds(lattr.typtr->sf.ar.inxtype,&lmin,&lmax);
  344.          if(gattr.typtr)
  345.           if(gattr.kind == cst) {       /* 添え字が定数の時           */
  346.            if((lmin<=gattr.cval.ival) && (gattr.cval.ival<=lmax)) {
  347.             incsize = (int)(gattr.cval.ival-lmin)*lsize ; /* 増分量   */
  348.             if(incsize) gen1t(iINC,nilptr,incsize);
  349.            }
  350.            else pcerr(148,"") ;        /* 添え字の定数が範囲内にない  */
  351.           }
  352.           else {                        /* 添え字が式の時             */
  353.            load() ;                     /* 添え字式をload             */
  354.            convertint(gattr.typtr) ;    /* 必要ならord命令生成        */
  355.            if(debug) genchk(intptr,1,lmin,lmax) ; /* chk命令生成      */
  356.            genixa(lmin,lsize) ;               /* lxa命令の生成        */
  357.           }
  358.         }
  359.        }
  360.        else pcerr(139,"") ;            /* 添え字の型が宣言と一致しない*/
  361.  
  362.        gattr.typtr  = lattr.typtr->sf.ar.aeltype ; /* 要素の型        */
  363.        gattr.kind   = varbl ;
  364.        gattr.access = indrct ;
  365.        gattr.idplmt = 0 ;
  366.       }
  367.  
  368.      } while(sy == comma) ;
  369.  
  370.      if(sy == rbrack) insymbol() ;
  371.      else pcerr(12,"") ;                /* ] がない                   */
  372. }
  373.  
  374. /*******************************************/
  375. /* ptr() : ポインタ参照,バッファ変数の処理 */
  376. /*******************************************/
  377. static void ptr(void)
  378. {
  379.      if(gattr.typtr)
  380.       if(gattr.typtr->form == pointer) { /* ポインタ型の時            */
  381.        load() ;
  382.        gattr.typtr = gattr.typtr->sf.pt.eltype ; /* 指し示すものの型  */
  383.        if(debug)                        /* デバッグコンパイルの時     */
  384.         gen0(iCKA) ;                    /* CKA命令                    */
  385.        gattr.kind   = varbl ;
  386.        gattr.access = indrct ;          /* 間接参照                   */
  387.        gattr.idplmt = 0      ;
  388.       }
  389.       else if(gattr.typtr->form == files){/* ファイル型の時           */
  390.        if(gattr.access == indrct)       /* ファイル変数が変数引数の時 */
  391.         gen2t(iLOD,nilptr,level-gattr.vlevel,gattr.dplmt) ;
  392.        gattr.typtr = gattr.typtr->sf.fi.filtype ; /* ファイルの基の型 */
  393.       }
  394.       else pcerr(141,"") ;              /* ファイル型か指標型でない   */
  395.  
  396.       insymbol() ;
  397. }
  398.  
  399. /**************************************/
  400. /* factor() : 式の因子(factor)の処理  */
  401. /**************************************/
  402. static void factor(Set fsys)
  403. {
  404.   Set ws ;
  405.  
  406.      if(! inset(facbegsys,sy)) {
  407.       pcerr(58,"") ;                    /* 項に誤りがある             */
  408.       ws = fsys ;
  409.       orset(&ws, &facbegsys) ;
  410.       skip(ws) ;                        /* fsys+factbegsysまで読み飛ばし*/
  411.       gattr.typtr = nil ;
  412.      }
  413.  
  414.      while(inset(facbegsys,sy)) {
  415.       switch(sy) {
  416.        case ident       :               /* 名前の時                   */
  417.               factident(fsys) ;
  418.               break ;
  419.        case intconst    :               /* 整数定数                   */
  420.        case realconst   :               /* 実数定数                   */
  421.        case stringconst :               /* 文字列                     */
  422.               factconst(fsys) ;
  423.               break ;
  424.        case lparent     :               /* (                          */
  425.               factlparent(fsys) ;
  426.               break ;
  427.        case notsy       :               /* not                        */
  428.               factnot(fsys) ;
  429.               break ;
  430.        case lbrack      :               /* [    集合の始まり記号      */
  431.               factset(fsys) ;
  432.               break ;
  433.        case nilsy       :               /* nil                        */
  434.               factnil() ;
  435.               break ;
  436.       }
  437.       if(! inset(fsys,sy)) {
  438.        pcerr(6,"") ;                    /* 不当な記号が現れた         */
  439.        skip(ws)    ;                    /* fsys+factbegsysまで読み飛ばし*/
  440.       }
  441.      }
  442. }
  443.  
  444. /**************************************/
  445. /*     factident() : 名前因子の処理   */
  446. /**************************************/
  447. static void factident(Set fsys)
  448. {
  449.   ctp *lcp ;
  450.   Set ws ;
  451.  
  452.      mkset(&ws, konst,vars,field,func,-1) ; /* 名前を､定数･変数･フィールド･ */
  453.      lcp = searchid(ws) ;                   /* 関数の中から探す             */
  454.      insymbol() ;
  455.  
  456.      if(lcp->klass == func) {
  457.       call(fsys,lcp) ;                  /* 関数の時､関数呼び出し      */
  458.       gattr.kind = expr ;
  459.       if(gattr.typtr)
  460.        if(gattr.typtr->form == subrange) /* 範囲型の時                */
  461.         gattr.typtr = gattr.typtr->sf.su.rangetype ; /* 基の型        */
  462.     }
  463.     else if(lcp->klass == konst) {      /* 定数の時                   */
  464.      gattr.typtr = lcp->idtype ;
  465.      gattr.kind  = cst ;
  466.      gattr.cval  = lcp->n.values ;      /*  値を入れる                */
  467.     }
  468.     else {                              /* 変数､レコードフィールドの時*/
  469.      selector(fsys,lcp) ;               /* 属性選択                   */
  470.      if(gattr.typtr)
  471.       if(gattr.typtr->form == subrange) /* 範囲型の時                 */
  472.        gattr.typtr = gattr.typtr->sf.su.rangetype ; /* 基の型         */
  473.     }
  474. }
  475.  
  476. /**************************************/
  477. /*     factconst() : 定数因子の処理   */
  478. /**************************************/
  479. static void factconst(Set fsys)
  480. {
  481.   stp *lsp,*lsp1 ;
  482.  
  483.      gattr.kind = cst ;
  484.      switch(sy) {
  485.       case intconst :                   /* 整数定数                   */
  486.         gattr.typtr = intptr ;
  487.         gattr.cval  = val    ;          /* 値を設定                   */
  488.         break ;
  489.  
  490.       case realconst :                  /* 実数定数                   */
  491.         gattr.typtr = realptr ;
  492.         gattr.cval   = val    ;
  493.         break ;
  494.  
  495.       case stringconst :                /* 文字列                     */
  496.         conststrings(&(gattr.typtr),&(gattr.cval));/*文字列定数の処理 */
  497.      }
  498.      insymbol() ;
  499. }
  500.  
  501. /**************************************/
  502. /*   factlparent() : (～)の処理       */
  503. /**************************************/
  504. static void factlparent(Set fsys)
  505. {
  506.   Set ws ;
  507.  
  508.      insymbol() ;
  509.      ws = fsys  ;
  510.      addset(ws,rparent) ;
  511.      expression(ws) ;                   /* )が出てくるまで式の処理    */
  512.      if(sy == rparent) insymbol() ;
  513.      else pcerr(4,"")             ;     /* ) がない                   */
  514. }
  515.  
  516. /**************************************/
  517. /*     factnot() : not の処理         */
  518. /**************************************/
  519. static void factnot(Set fsys)
  520. {
  521.      insymbol()   ;
  522.      factor(fsys) ;                     /* notの次の因子の解析        */
  523.      load()       ;                     /* load命令の出力             */
  524.      if(gattr.typtr != boolptr) {
  525.       pcerr(135,"not") ;                /*  論理型でないといけない    */
  526.       gattr.typtr = nil  ;              /*  次のエラーをださないためnil*/
  527.      }
  528.      gen0(iNOT)   ;                     /* not命令の出力              */
  529. }
  530.  
  531. /**************************************/
  532. /*     factset() : 集合の処理         */
  533. /**************************************/
  534. static void factset(Set fsys)
  535. {
  536.   stp *lsp ;
  537.   csp *lvp ;
  538.   long    csetpart;                     /* 集合の定数要素パート       */
  539.   boolean varpart ;                     /* 変数要素がある時 true      */
  540.   boolean cstpart ;                     /* 定数要素がある時 true      */
  541.   boolean test   ;
  542.   Set ws  ;
  543.  
  544.      insymbol() ;
  545.      csetpart= 0         ;              /* 固定要素集合のクリア       */
  546.      varpart = false     ;
  547.      cstpart = false     ;
  548.      lsp = (stp*)Malloc(sizeof(stp)) ;  /* 集合の型を作成             */
  549.      lsp->form          = power  ;
  550.      lsp->size         = setsize ;
  551.      lsp->assignflag   = true    ;
  552.      lsp->sf.pw.packed = both    ;
  553.      lsp->sf.pw.elset  = nil     ;
  554.      lsp->sf.pw.elmin  = setlow  ;
  555.      lsp->sf.pw.elmax  = sethigh ;
  556.  
  557.      if(sy == rbrack) {                 /* 空集合の時                 */
  558.       gattr.typtr = lsp ;
  559.       gattr.kind  = cst ;
  560.       insymbol() ;
  561.      }
  562.  
  563.      else {                             /* 要素がある時               */
  564.       do {
  565.        mkset(&ws,comma,rbrack,period2,-1);
  566.        orset(&ws,&fsys) ;
  567.        expression(ws)   ;               /* 要素                       */
  568.        if(gattr.typtr)
  569.         if((gattr.typtr->form != scalar)/* 要素が順序型かチェック     */
  570.         || (gattr.typtr == realptr)) {
  571.          pcerr(136,"") ;                /*  要素記述は順序型のこと　  */
  572.          gattr.typtr = nil ;
  573.         }
  574.         else {
  575.          if(!lsp->sf.pw.elset)          /* 集合の型がない時           */
  576.           lsp->sf.pw.elset = gattr.typtr ;/* 要素の型を集合の型とする */
  577.          if(compatible(lsp->sf.pw.elset,gattr.typtr)){   /* 要素の型  */
  578.           if(sy == period2)
  579.            factset2(fsys,lsp,&csetpart,&cstpart,&varpart);/* ..の処理 */
  580.           else {                        /* 通常の集合要素の処理       */
  581.            if(gattr.kind == cst)        /* 要素が定数                 */
  582.             if((gattr.cval.ival < (long)lsp->sf.pw.elmin) || /* 集合の*/
  583.                (gattr.cval.ival > (long)lsp->sf.pw.elmax))   /* 範囲  */
  584.              pcerr(607,inttoch((long)lsp->sf.pw.elmax)) ;/* 範囲内にない*/
  585.             else {
  586.              csetpart |=(1L << gattr.cval.ival);/* 集合の定数要素を加える*/
  587.              cstpart = true ;
  588.             }
  589.            else {                       /* 要素が変数の時             */
  590.             load() ;                    /* 要素値をload               */
  591.             convertint(gattr.typtr) ;   /* 必要ならord命令生成        */
  592.             if(debug)
  593.              genchk(intptr,111,         /* 式がHAPPyの集合範囲に入るか*/
  594.              (long)lsp->sf.pw.elmin,(long)lsp->sf.pw.elmax) ;
  595.                                         /*  集合要素の範囲チェック    */
  596.             gen0(iSGS) ;                /* sgs命令(要素1個の集合作成) */
  597.             if(varpart) gen0(iUNI)  ;   /* uni命令(変数の集合に加える)*/
  598.             else varpart = true     ;   /* 初めて変数が現れた時 trueに*/
  599.            }
  600.           }
  601.          }
  602.          else pcerr(137,"") ;           /* 集合の要素の型が不一致     */
  603.         }
  604.  
  605.        if(test=(sy==comma)) insymbol(); /* , なら次の要素を読む       */
  606.       } while(test) ;                   /* , ならば次の要素の処理     */
  607.  
  608.       if(sy == rbrack) insymbol() ;     /* ] ならば次のsymbolを読む   */
  609.       else pcerr(12,"") ;               /* ] がない                   */
  610.  
  611.       gattr.typtr = lsp ;               /* 集合の型を入れる           */
  612.      }
  613.  
  614.      lvp = (csp*)Malloc(sizeof(csp)) ;  /* 集合定数のエリア確保       */
  615.      lvp->cclass = pset ;
  616.      lvp->c.pval = csetpart ;
  617.      gattr.cval.valp = lvp  ;
  618.  
  619.      if(varpart && cstpart) {           /* 変数要素と定数要素両方あり */
  620.        genldc('s',(long)nil) ;          /* ldcs命令                   */
  621.        gen0(iUNI) ;                     /* uni命令                    */
  622.        gattr.kind = expr ;
  623.       }
  624. }
  625.  
  626. /****************************************/
  627. /*  loadelement() :  集合の 範囲要素load*/
  628. /****************************************/
  629. static void loadelement(stp *fsp,boolean *varpart,int kind)
  630. {
  631.   int pope ;                            /* mms命令の p オペランド
  632.                                             0 下限 上限  チェックなし
  633.                                             1 下限 上限  チェックあり
  634.                                             2 上限 下限  チェックなし
  635.                                             3 上限 下限  チェックあり */
  636.     /* debugオプション指定時に chk命令以外でチェックさせるのは
  637.        このmms命令のみ。統一がとれていないけど、暫定的にこのようにした*/
  638.  
  639.      pope = kind + (int)(debug) ;
  640.      load() ;                           /* 要素式をload               */
  641.      convertint(gattr.typtr)    ;       /* 必要ならord命令生成        */
  642.      genp(iMMS,pope)            ;       /* mms命令生成                */
  643.      if(*varpart) gen0(iUNI)    ;       /* uni命令(変数の集合に加える)*/
  644.      else *varpart = true       ;
  645. }
  646.  
  647. /****************************************/
  648. /*  factset2() :  集合の 範囲要素の処理 */
  649. /*                 順序式..順序式       */
  650. /****************************************/
  651. static void factset2(Set fsys,stp *fsp,
  652.               long *csetpart,boolean *cstpart,boolean *varpart)
  653. {
  654.   attr lattr,lattr2 ;
  655.   short m    ;
  656.   Set ws     ;
  657.  
  658.      lattr = gattr ;
  659.      if(gattr.kind != cst) {            /* 定数以外 ･･･ 式            */
  660.       load() ;                          /* 要素式をload               */
  661.       convertint(gattr.typtr) ;         /* 必要ならord命令生成        */
  662.       insymbol() ;                      /* 次の要素を読む             */
  663.       mkset(&ws,comma,rbrack,-1);
  664.       orset(&ws,&fsys);
  665.       expression(ws)  ;                 /* 次の要素の処理             */
  666.       if(gattr.typtr)
  667.        if(compatible(gattr.typtr,lattr.typtr))/* 前の要素との型チェック*/
  668.         loadelement(fsp,varpart,0) ;    /* 上限式load&mms             */
  669.        else pcerr(137,"") ;             /* 集合の要素の型が不一致     */
  670.      }
  671.      else {                             /* 最初の要素が定数の時       */
  672.       insymbol() ;                      /* 次の要素を読む             */
  673.       mkset(&ws,comma,rbrack,-1);
  674.       orset(&ws,&fsys);
  675.       expression(ws)  ;                 /* 次の要素の処理             */
  676.       if(gattr.typtr)
  677.        if(compatible(gattr.typtr,lattr.typtr)) {/* 前の要素との型チェック*/
  678.         if(gattr.kind == cst) {         /* 上限値が定数               */
  679.          if(lattr.cval.ival <= gattr.cval.ival)   /*上限値の方が大きい*/
  680.           if((lattr.cval.ival >= (long)fsp->sf.pw.elmin) &&/* 要素の範囲*/
  681.              (gattr.cval.ival <= (long)fsp->sf.pw.elmax)){ /*   チェック*/
  682.            for(m=(short)lattr.cval.ival;m<=(short)gattr.cval.ival;m++)
  683.             *csetpart |=(1L << m);      /* 集合の定数要素を加える     */
  684.            *cstpart = true ;
  685.           }
  686.           else
  687.            pcerr(607,inttoch((long)fsp->sf.pw.elmax)) ;/* 範囲内にない*/
  688.         }
  689.         else {                          /* 定数..式                   */
  690.          load() ;                       /* 上限式をload               */
  691.          convertint(gattr.typtr) ;      /* 必要ならord命令生成        */
  692.          gattr = lattr    ;
  693.          loadelement(fsp,varpart,2) ;   /* 下限定数load&mms           */
  694.         }
  695.        }
  696.        else pcerr(137,"") ;             /* 集合の要素の型が不一致     */
  697.      }
  698. }
  699.  
  700. /**************************************/
  701. /*     factnil() : nil の処理         */
  702. /**************************************/
  703. static void factnil(void)
  704. {
  705.      gattr.typtr      = nilptr ;        /* nil 型                     */
  706.      gattr.kind       = cst    ;
  707.      gattr.cval.ival  = 0      ;
  708.      insymbol()                ;
  709. }
  710.  
  711. /**************************************/
  712. /*    term() : 式の項(term)の処理     */
  713. /**************************************/
  714. static void term(Set fsys)
  715. {
  716.   attr lattr ;                          /* 1つ前の項の属性            */
  717.   enum operator lop ;                   /* 1つ前の演算子              */
  718.   Set ws ;
  719.  
  720.      ws = fsys ;
  721.      addset(ws,mulop) ;
  722.      factor(ws) ;                       /* 因子の処理                 */
  723.  
  724.      while(sy == mulop) {               /* * / div mod and の時       */
  725.       load() ;                          /* 今の項をload               */
  726.       lattr = gattr ;                   /* 今の項の属性を退避         */
  727.       lop   = op    ;                   /* 今の演算子を退避           */
  728.       insymbol() ;
  729.       factor(ws) ;                      /* 次の項の処理               */
  730.       load() ;                          /* その項をload               */
  731.       if((lattr.typtr) && (gattr.typtr))
  732.        switch(lop) {                    /* 演算子で振り分ける         */
  733.         case mul  : mulope(lattr) ;     /*  * 演算子処理              */
  734.                     break         ;
  735.         case rdiv : rdivope(lattr) ;    /*  / 演算子処理              */
  736.                     break          ;
  737.         case idiv  :                    /*  div 演算子                */
  738.         case imod  :                    /*  mod 演算子                */
  739.           if((lattr.typtr == intptr) &&
  740.              (gattr.typtr == intptr))   /*  div/mod の対象はinteger   */
  741.            (lop==idiv) ? gen0(iDVI) : gen0(iMOD);/*dvi / mod命令を生成*/
  742.           else {
  743.            pcerr(134,"") ;              /* 演算対象の型に誤り         */
  744.            gattr.typtr = nil ;
  745.           }
  746.           break ;
  747.         case andop :                    /*  and 演算子                */
  748.           if((lattr.typtr == boolptr) &&
  749.              (gattr.typtr == boolptr))  /*  and の対象はboolean       */
  750.            gen0(iAND) ;                 /*   and命令を生成            */
  751.           else {
  752.            pcerr(135,"and") ;           /* 論理型でない               */
  753.            gattr.typtr = nil ;
  754.           }
  755.        }
  756.       else gattr.typtr = nil ;
  757.      }
  758. }
  759.  
  760. /**************************************/
  761. /*      mulope() : *  演算子処理      */
  762. /**************************************/
  763. static void mulope(attr fattr)
  764. {
  765.      if((fattr.typtr == intptr) &&      /*  * の両端がinteger         */
  766.         (gattr.typtr == intptr))
  767.       gen0(iMPI) ;                      /* mpi命令の生成              */
  768.      else {
  769.       cnvfloat(&fattr) ;                /* realへの変換処理           */
  770.       if((fattr.typtr == realptr) &&
  771.          (gattr.typtr == realptr))      /* 両端ともrealになっていれば */
  772.        gen0(iMPR) ;                     /*  mpr命令を生成             */
  773.       else if((gattr.typtr->form == power)        /* 集合型で         */
  774.         && compatible(fattr.typtr,gattr.typtr)) { /* 型が適合する     */
  775.         if(fattr.typtr->sf.pw.packed != both) /* 前の式の詰めあり/なし*/
  776.          gattr.typtr->sf.pw.packed = fattr.typtr->sf.pw.packed   ;
  777.        gen0(iINT) ;                     /* int命令を生成              */
  778.       }
  779.       else {                            /* 型が適合しない             */
  780.        pcerr(134,"") ;                  /* 演算対象の型に誤り         */
  781.        gattr.typtr = nil;
  782.       }
  783.      }
  784. }
  785.  
  786. /**************************************/
  787. /*      rdivope() : /  演算子処理     */
  788. /**************************************/
  789. static void rdivope(attr fattr)
  790. {
  791.      cnvfloat(&fattr) ;                 /* realへの変換処理           */
  792.      if((fattr.typtr == realptr) &&
  793.         (gattr.typtr == realptr))       /* 両端ともrealになっていれば */
  794.       gen0(iDVR) ;                      /*  dvr命令を生成             */
  795.       else {
  796.        pcerr(134,"") ;                  /* 演算対象の型に誤り         */
  797.        gattr.typtr = nil ;
  798.       }
  799. }
  800.  
  801.  
  802. /*********************************************/
  803. /*     simpleexpression() : 単純式の処理     */
  804. /*********************************************/
  805. static void simpleexpression(Set fsys)
  806. {
  807.   boolean sign = false ;
  808.   boolean neg ;
  809.   attr lattr ;
  810.   enum operator lop ;
  811.   Set ws ;
  812.  
  813.      sign = (op==plus) || (op==minus) ; /* + か - の時 真             */
  814.      if(sign) {
  815.       neg = (op == minus)    ;          /* - の時 true                */
  816.       insymbol() ;
  817.      }
  818.  
  819.      ws = fsys ;
  820.      addset(ws,addop) ;
  821.      term(ws) ;                         /* 項の処理                   */
  822.  
  823.      if(sign) {                         /* + -  がついていた時        */
  824.        if(gattr.typtr==intptr) {
  825.         if(neg)
  826.          if(gattr.kind==cst)            /* 定数の時は 値を反転する    */
  827.           gattr.cval.ival = -gattr.cval.ival ;
  828.          else {                          /* 変数の時                   */
  829.           load() ;
  830.           gen0(iNGI)  ;                  /* ngi 命令の出力             */
  831.          }
  832.        }
  833.        else if(gattr.typtr==realptr) {  /* 実数は定数でもngr命令      */
  834.         if(neg) {
  835.          load() ;
  836.          gen0(iNGR) ;                   /* ngr 命令の出力             */
  837.         }
  838.        }
  839.        else {                           /* 整数､実数以外に符号がついている*/
  840.         pcerr(134,"") ;                 /* 演算対象の型に誤り         */
  841.         gattr.typtr = nil ;             /* 今後のためにnilとする      */
  842.        }
  843.      }
  844.  
  845.      while(sy ==addop) {
  846.       load()        ;
  847.       lattr = gattr ;                   /* 今の属性を退避             */
  848.       lop   = op    ;                   /* 今の演算子を退避           */
  849.       insymbol()    ;
  850.       term(ws)      ;                   /* 項の処理                   */
  851.  
  852.       if((lattr.typtr) && (gattr.typtr))
  853.        switch(lop) {                    /* 前の演算子で振り分ける    */
  854.         case plus  :
  855.         case minus : plusminusope(lattr,lop);
  856.                      break           ;  /* + -  の演算子処理          */
  857.         case orop  : load()          ;
  858.                      orope(lattr)    ;  /* or     演算子処理          */
  859.                      break           ;
  860.        }
  861.       else gattr.typtr = nil    ;
  862.      }
  863. }
  864.  
  865. /**************************************/
  866. /* plusminusope() : + -  演算子処理   */
  867. /**************************************/
  868. static void plusminusope(attr fattr,enum operator fop)
  869. {
  870.      if((fattr.typtr == intptr) &&      /* 前と今の式が両方ともinteger*/
  871.         (gattr.typtr == intptr))        /*   であれば                 */
  872.       if((gattr.kind == cst) &&
  873.          (gattr.cval.ival <= 32767)) {
  874.         (fop == plus)
  875.           ? gen1t(iINC,intptr,(int)gattr.cval.ival)
  876.           : gen1t(iDEC,intptr,(int)gattr.cval.ival) ;
  877.          gattr.kind = expr ;
  878.       }
  879.       else {
  880.        load() ;
  881.        (fop == plus) ? gen0(iADI) : gen0(iSBI) ; /* adi/sbi命令を生成 */
  882.       }
  883.      else {
  884.       load() ;
  885.       cnvfloat(&fattr) ;                /* realに変換                 */
  886.       if((fattr.typtr == realptr) &&    /* 前と今の式が両方ともreal   */
  887.          (gattr.typtr == realptr))      /*   になっていれば           */
  888.        (fop == plus) ? gen0(iADR) : gen0(iSBR) ; /* adr/sbr命令を生成 */
  889.       else if((fattr.typtr->form == power)       /* 前の式が集合型で  */
  890.          && compatible(fattr.typtr,gattr.typtr)){/* 基底の型が同じ    */
  891.        if(fattr.typtr->sf.pw.packed != both)  /* 前の式の詰めあり/なし*/
  892.         gattr.typtr->sf.pw.packed = fattr.typtr->sf.pw.packed   ;
  893.        load() ;
  894.        (fop == plus) ? gen0(iUNI) : gen0(iDIF) ; /* uni/dif命令を生成 */
  895.       }
  896.       else {                            /* 型が適合しない             */
  897.        pcerr(134,"") ;                  /* 演算対象の型に誤り         */
  898.        gattr.typtr = nil;
  899.       }
  900.      }
  901. }
  902.  
  903. /**************************************/
  904. /*      orope() : or 演算子処理       */
  905. /**************************************/
  906. static void orope(attr fattr)
  907. {
  908.       if((fattr.typtr == boolptr) &&    /* 前と今の式が両方ともboolean*/
  909.          (gattr.typtr == boolptr))      /*   であれば                 */
  910.        gen0(iIOR) ;                     /*   ior命令を生成            */
  911.       else {
  912.        pcerr(135,"or") ;              /*  演算対象は論理型でないと駄目*/
  913.        gattr.typtr = nil ;
  914.       }
  915. }
  916.